home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / enumvar.cls < prev    next >
Text File  |  1997-06-14  |  3KB  |  98 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "CEnumVariant"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. Option Explicit
  11.  
  12. ' Implement VB version of IEnumVARIANT (from type library interface)
  13. Implements IVBEnumVARIANT
  14.  
  15. Public Enum EErrorEnumVariant
  16.     eeBaseEnumVariant = 13050   ' CEnumVariant
  17. End Enum
  18.  
  19. Private connect As IVariantWalker
  20.  
  21. ' Delegators must connect themselves so we can call back
  22. Sub Attach(connectA As IVariantWalker)
  23.     Set connect = connectA
  24. End Sub
  25.  
  26. Private Sub Class_Initialize()
  27.     ' Only executes once for life of program
  28.     If MEnumVariant.fNotFirstTime = False Then
  29.         MEnumVariant.fNotFirstTime = True
  30.         ' There's only one v-table for the object, so modify it once
  31.         Dim iev As IVBEnumVARIANT
  32.         Set iev = Me
  33.         ' Ignore item 1: QueryInterface
  34.         ' Ignore item 2: AddRef
  35.         ' Ignore item 3: Release
  36.         ReplaceVtableEntry ObjPtr(iev), 4, AddressOf MEnumVariant.BasNext
  37.         ReplaceVtableEntry ObjPtr(iev), 5, AddressOf MEnumVariant.BasSkip
  38.         ' Ignore item 6: Reset
  39.         ' Ignore item 7: Clone
  40.     End If
  41. End Sub
  42.  
  43. '' Dummy versions of implemented functions are replaced by standard module versions
  44.  
  45. Private Sub IVBEnumVARIANT_Next(ByVal cv As Long, v As Variant, ByVal cvFetched As Long)
  46.     BugMessage "Dummy Next"
  47. End Sub
  48.  
  49. Private Sub IVBEnumVARIANT_Skip(ByVal cv As Long)
  50.     BugMessage "Dummy Skip"
  51. End Sub
  52.  
  53. ' Can be implemented directly--no need to mess with the v-table
  54. Private Sub IVBEnumVARIANT_Reset()
  55.     BugAssert Not connect Is Nothing
  56.     connect.Reset
  57.     BugMessage "Reset"
  58. End Sub
  59.  
  60. ' Not implemented--just raise an error
  61. Private Sub IVBEnumVARIANT_Clone(ppenum As stdole.IEnumVARIANT)
  62.     Err.Raise &H80004001     ' E_NOTIMPL
  63. End Sub
  64.  
  65. '' Object methods called by standard module v-table functions contain implementation
  66.  
  67. Function ClsNext(v As Variant) As Boolean
  68.     BugAssert Not connect Is Nothing
  69.     ClsNext = connect.More(v)
  70. End Function
  71.  
  72. Sub ClsSkip(c As Long)
  73.     BugAssert Not connect Is Nothing
  74.     connect.Skip c
  75.     BugMessage "Skip"
  76. End Sub
  77.  
  78. #If fComponent = 0 Then
  79. Private Sub ErrRaise(e As Long)
  80.     Dim sText As String, sSource As String
  81.     If e > 1000 Then
  82.         sSource = App.ExeName & ".EnumVariant"
  83.         Select Case e
  84.         Case eeBaseEnumVariant
  85.             BugAssert True
  86.        ' Case ee...
  87.        '     Add additional errors
  88.         End Select
  89.         Err.Raise COMError(e), sSource, sText
  90.     Else
  91.         ' Raise standard Visual Basic error
  92.         sSource = App.ExeName & ".VBError"
  93.         Err.Raise e, sSource
  94.     End If
  95. End Sub
  96. #End If
  97.  
  98.